program polygon_clipping ;

{$U+}

{$I GRAPH.P}

const
  numstate = $20 ;

type
  rec = record
       x1 , y1 : integer ;
       x2 , y2 : integer ;
       flag : boolean ;
    end ;
  arry = array [1..20] of rec ;

 var
   i , j , topx , topy , bottomx , bottomy , retval  : integer ;
   m , x , y , intersection : real ;
   arr : arry ;
   x1 , y1 , x2 , y2 , flag , ctr : integer ;
   c : char ;
   kbflag : byte absolute $0040:$0017 ;

procedure setnum ;
 begin
   kbflag := kbflag or numstate ;
 end ;

procedure resetnum ;
 begin
   kbflag := kbflag and 0 ;
 end ;

procedure draw_win ;
 begin
   draw(topx,topy,bottomx,topy,3) ;
   draw(bottomx,topy,bottomx,bottomy,3) ;
   draw(bottomx,bottomy,topx,bottomy,3) ;
   draw(topx,bottomy,topx,topy,3) ;
 end ;

procedure clip_it ;
 var
   i : integer ;

   procedure above ;
    begin
      for i := 1 to ctr do
       begin
         if ( ( arr[i].y1 <= topy ) and ( arr[i].y2 <= topy ) ) then
           arr[i].flag := false
         else
           if ( not (( arr[i].y1 >= topy ) and ( arr[i].y2 >= topy )) ) then
            begin
              intersection := (topy - arr[i].y1) / (arr[i].y2 - arr[i].y1) * (arr[i].x2 - arr[i].x1) + arr[i].x1 ;
              if ( arr[i].y1 <= arr[i].y2 ) then
               begin
                 arr[i].y1 := topy ;
                 arr[i].x1 := round(intersection) ;
               end
              else
               if (arr[i].y2 <= arr[i].y1) then
                 begin
                   arr[i].y2 := topy ;
                   arr[i].x2 := round(intersection) ;
                 end ;
            end ;
       end ;
    end ;

   procedure below ;
    begin
      for i := 1 to ctr do
       begin
         if (( arr[i].y1 >= bottomy ) and ( arr[i].y2 >= bottomy )) then
           arr[i].flag := false
         else
           if ( not (( arr[i].y1 <= bottomy ) and ( arr[i].y2 <= bottomy )) ) then
            begin
              intersection := (bottomy - arr[i].y1) / (arr[i].y2 - arr[i].y1) * (arr[i].x2 - arr[i].x1) + arr[i].x1 ;
              if ( arr[i].y1 >= arr[i].y2 ) then
               begin
                 arr[i].y1 := bottomy ;
                 arr[i].x1 := round(intersection)
               end
              else
               if ( arr[i].y1 <= arr[i].y2 ) then
                begin
                  arr[i].y2 := bottomy ;
                  arr[i].x2 := round(intersection) ;
                end ;
            end ;
       end ;
    end ;

   procedure left ;
    begin
      for i := 1 to ctr do
       begin
         if (( arr[i].x1 <= topx ) and ( arr[i].x2 <= topx )) then
           arr[i].flag := false
         else
           if ( not (( arr[i].x1 >= topx ) and ( arr[i].x2 >= topx )) ) then
            begin
              intersection := (topx - arr[i].x1) / (arr[i].x2 - arr[i].x1) * (arr[i].y2 - arr[i].y1) + arr[i].y1 ;
              if ( arr[i].x1 <= arr[i].x2 ) then
               begin
                 arr[i].x1 := topx ;
                 arr[i].y1 := round(intersection) ;
               end
              else
               if (arr[i].x2 <= arr[i].x1) then
                begin
                  arr[i].x2 := topx ;
                  arr[i].y2 := round(intersection) ;
                end ;
            end ;
       end ;
    end ;

   procedure right ;
    begin
      for i := 1 to ctr do
       begin
         if (( arr[i].x1 >= bottomx ) and ( arr[i].x2 >= bottomx )) then
           arr[i].flag := false
         else
           if ( not (( arr[i].x1 <= bottomx ) and ( arr[i].x2 <= bottomx )) ) then
            begin
              intersection := (bottomx - arr[i].x1) / (arr[i].x2 - arr[i].x1) * (arr[i].y2 - arr[i].y1) + arr[i].y1 ;
              if ( arr[i].x2 <= arr[i].x1 ) then
               begin
                 arr[i].x1 := bottomx ;
                 arr[i].y1 := round(intersection) ;
               end
              else
               if (arr[i].x1 <= arr[i].x2) then
                begin
                  arr[i].x2 := bottomx ;
                  arr[i].y2 := round(intersection) ;
                end ;
            end ;
       end ;
    end ;

  begin
   for i := 1 to ctr do
     arr[i].flag := true ;
   clearscreen ;
   draw_win ;
   above ;
   below ;
   left ;
   right ;
   for i := 1 to ctr do
      if ( arr[i].flag ) then
         draw(arr[i].x1,arr[i].y1,arr[i].x2,arr[i].y2,3) ;
 end ;

begin
  retval := 0 ;
  x1 := 160 ;
  x2 := x1 ;
  y1 := 100 ;
  y2 := y1 ;
  ctr := 0 ;
  clrscr ;
  graphmode ;
  setnum ;
  c := '0' ;
  while ( ord(c) <> 27 ) do
   begin
    plot(x2,y2,3) ;
    read(kbd,c) ;
    c := upcase(c) ;
    if ( c = 'E' ) then
     begin
       for i := 1 to ctr do
         arr[i].flag := true ;
       clearscreen ;
       ctr := 0 ;
       draw_win ;
     end ;
    if ( c = 'C' ) then
     begin
       draw_win ;
       arr[ctr].x2 := arr[1].x1 ;
       arr[ctr].y2 := arr[1].y1 ;
       for i := 1 to ctr do
          draw(arr[i].x1,arr[i].y1,arr[i].x2,arr[i].y2,3) ;
       readln ;
       clip_it ;
     end ;
    case c of
      '8' : begin
              if ( y2 > 0 ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 - 1 ;
               end ;
            end ;
      '2' : begin
              if ( y2 < 199 ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 + 1 ;
               end ;
            end ;
      '4' : begin
              if ( x2 > 0 ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 x2 := x2 - 1 ;
               end ;
            end ;
      '6' : begin
              if ( x2 < 319 ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 x2 := x2 + 1 ;
               end ;
            end ;
      '7' : begin
              if ( ( y2 > 0 ) and ( x2 > 0 ) ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 - 1 ;
                 x2 := x2 - 1 ;
               end ;
            end ;
      '9' : begin
              if ( ( y2 > 0 ) and ( x2 < 319 ) ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 - 1 ;
                 x2 := x2 + 1 ;
               end ;
            end ;
      '1' : begin
              if ( ( y2 < 199 ) and ( x2 > 0 ) ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 + 1 ;
                 x2 := x2 - 1 ;
               end ;
            end ;
      '3' : begin
              if ( ( y2 < 199 ) and ( x2 < 319 ) ) then
               begin
                 if ( flag = 0 ) then
                    plot(x2,y2,0) ;
                 flag := 0 ;
                 y2 := y2 + 1 ;
                 x2 := x2 + 1 ;
               end ;
            end ;
     end ;
   if ( ord(c) = 13 ) then
    begin
      plot(x2,y2,3) ;
      flag := 1 ;
      x1 := x2 ;
      y1 := y2 ;
      if ( retval = 3 ) then
       begin
         ctr := ctr + 1 ;
         arr[ctr-1].x2 := x1 ;
         arr[ctr-1].y2 := y1 ;
         arr[ctr].x1 := x1 ;
         arr[ctr].y1 := y1 ;
         retval := 3 ;
       end ;
      if ( retval = 2 ) then
       begin
         ctr := ctr + 1 ;
         arr[ctr].x1 := x1 ;
         arr[ctr].y1 := y1 ;
         retval := 3 ;
       end ;
      if ( retval = 1 ) then
       begin
         bottomx := x1 ;
         bottomy := y1 ;
         retval := 2 ;
         draw_win ;
       end ;
      if ( retval = 0 ) then
       begin
         topx := x1 ;
         topy := y1 ;
         retval := 1 ;
       end ;
    end ;
  end ;
  resetnum ;
  textmode(bw80) ;
end .
